#! /usr/local/bin/perl

###########################################################################
#
# Geek::Dev::Debug
#
###########################################################################
#
# Include this module to indicate your Perl script is running in test mode.
# This has two primary effects:
#
#	1) When you include a local Perl module, it will be drawn from your
#		private testing area (as determined by the VCtools config file).
#		Standard Perl modules will generally not change, although you
#		could potentially use this mechanism to create your own 'strict.pm'
#		or somesuch (but I wouldn't advise it).
#
#	2) There is now a DEBUG constant that is defined to the value you pass
#		in to this module.  For instance:
#
#				use Geek::Dev::Debug(1);
#
#				print DEBUG, "\n";			# prints 1
#
#		Note that this is a compile-time constant, so that if you do something
#		like this:
#
#				print "my variable is $myvar\n" if DEBUG >= 2;
#
#		then not only will the program never print the statement when DEBUG
#		is 0 or 1, but it won't even test the value.  The code is completely
#		removed during the compile phase (because of constant folding).  Thus
#		you can leave in debugging statements without fear of slowing down
#		production code.
#
# To turn off debugging, change your use statement thus:
#
#				use Geek::Dev::Debug(0);
#
# but don't just comment it out.  If you did that, your code containing
# DEBUG wouldn't compile any more.
#
# To make things a little more clear, you can also do something like this:
#
#				use Geek::Dev::Debug qw<OFF>;
#
# The module accepts "off", "false", and (just for fun) "not!" in a case
# insensitive manner.
#
# You also need to make sure you put your "use Geek::Dev::Debug" before any
# other local "use" statements, or you won't be able to get the debugging
# versions of those modules.  In general, it is recommended that you put
# your "use Geek::Dev::Debug" statement as early as possible in your script
# (but it doesn't have to come before the "use strict").
#
# The value of DEBUG is designed to "fall through" to libraries and modules
# that are aware of it.  If you do this:
#
#				use Geek::Dev::Debug;
#
# in a module, it means that you wish to use the value of DEBUG that was set
# in a higher level module (probably the top level Perl program).  If no
# such value was ever set, DEBUG will be 0.
#
# It probably also bears noting that you can't actually test changes to the
# Geek::Dev::Debug.pm module itself via this method, because of the distinct
# chicken-and-egg problem it engenders.
#
# #########################################################################
#
# All the code herein is Copyright (c) 2004 ThinkGeek.
# Don't steal it.  Thanks.
#
###########################################################################

package Geek::Dev::Debug;

### Private ###############################################################

use strict;

use Carp;

our %word_vals =
(
	OFF		=>	0,
	FALSE	=>	0,
	'NOT!'	=>	0,
);


###########################
# Subroutines:
###########################


sub import
{
	my $pkg = shift;
	my $debug_value = shift;
	# print STDERR "==============\n@INC\nhere i am in debug import with value ";
	# print STDERR defined $debug_value ? $debug_value : "undefined", "\n";

	# the "master" value is in the Geek namespace
	# (sort of like main:: but it'll work under mod_perl too)
	# get the master value: if it's undefined, we'll need to define it;
	# if it's defined, we'll need to use it as a default value
	my $master_debug = eval "Geek::DEBUG();";
	# print STDERR "eval returns $master_debug and eval err is $@\n";

	my $caller_package = caller;
	# print STDERR "my calling package is $caller_package\n";
	my $caller_defined = defined eval "${caller_package}::DEBUG();";

	if (not defined $debug_value)
	{
		# if already defined in the caller, just assume that all is well
		# with the world; in this one case (only) a duplicate is allowed
		return if $caller_defined;

		# if neither one is defined, assume 0 (debugging off)
		$debug_value = defined $master_debug ? $master_debug : 0;
	}
	elsif (exists $word_vals{uc $debug_value})
	{
		$debug_value = $word_vals{uc $debug_value};
	}
	else
	{
		croak("Geek::Dev::Debug: I only understand positive integers "
				. " and a few select words")
						unless $debug_value =~ /^\d+$/;
	}

=original_code
	croak("DEBUG already defined; don't use Geek::Dev::Debug twice")
			if $caller_defined;
=cut

	$debug_value = 1 unless defined $debug_value;
	eval "sub ${caller_package}::DEBUG () { return $debug_value; }";

	# also have to tuck this value into the Geek namespace
	# if it isn't already there
	eval "sub Geek::DEBUG () { return $debug_value; }"
			unless defined $master_debug;

	# print STDERR "leaving import now\n";
}


###########################
# Return a true value:
###########################

1;
